SPACE 2/SPACE - Library 2 - Volume 1.iso/games/65/pascal/spheres.pas

Pascal/Delphi Source File | 1986-10-16 | 8.8 KB | 435 lines

program spheres;

{
This program draws spheres of various sizes on the graphics screen.
}

const
  {$i gemconst.pas}
  maxx        = 639;
  minx        =   0;
  maxy        = 399;
  miny        =   0;
  white_color =   0;
  black_color =   1;

  pi = 3.141592654;

type
  {$i gemtype.pas}
  mode_type = (draw, erase);

var
  plotting_window : integer;
  quit            : boolean;


{$i gemsubs.pas}


procedure start_graphics(var plotting_window : integer);

{
Set up and clear a plotting window.
}

var
  null_string : string;

begin

  null_string := '';

  hide_mouse;

  plotting_window := new_window(0, null_string, 0, 0, maxx + 1, maxy + 1);
  open_window(plotting_window, 0, 0, maxx + 1, maxy + 1);

  paint_color(white_color);
  paint_rect(0, 0, maxx + 1, maxy + 1);
  line_color(black_color);

end;


procedure stop_graphics(plotting_window : integer);

{
Delete plotting window.
}

begin

  close_window(plotting_window);
  delete_window(plotting_window);

  show_mouse;

end;


function point_in_range(x, y : integer) : boolean;

{
Return true only when point (x, y) is on the screen.
}

begin

  point_in_range := (x >= 0) and (x <= maxx) and
                    (y >= 0) and (y <= maxy);

end;


procedure point(x, y : integer);

{
Plot a point on the screen if it is in range.
}

begin

  if point_in_range(x, y)
    then plot(x, maxy - y);

end;


function min(a, b : integer) : integer;

{
Return the lesser of a and b.
}

begin

  if a < b
    then min := a
    else min := b;

end;


function max(a, b : integer) : integer;

{
Return the greater of a and b.
}

begin

  if a > b
    then max := a
    else max := b;

end;


procedure draw_line(x0, y0, x1, y1 : integer; draw_mode : mode_type);

{
Draw or erase a line on the screen if at least one point is within the
boundries of the screen.
}

begin

  if point_in_range(x0, y0) or point_in_range(x1, y1)
    then begin

      x0 := max(x0, 0);
      y0 := max(y0, 0);
      x1 := max(x1, 0);
      y1 := max(y1, 0);

      x0 := min(x0, maxx);
      y0 := min(y0, maxy);
      x1 := min(x1, maxx);
      y1 := min(y1, maxy);

      if draw_mode = erase
        then line_color(white_color);

      line(x0, maxy - y0, x1, maxy - y1);

      if draw_mode = erase
        then line_color(black_color);

    end;

end;


function mouse_button_pressed : boolean;

{
Return true when the left mouse button is depressed (false otherwise).  Do
not wait for button to be pressed.
}

const
  left_button = $0001;
  button_down = $0001;

var
  event,
  discard      : integer;
  message_area : message_buffer;

begin

  event := get_event(e_button | e_timer, left_button, button_down, 0, 0,
                     false, 0, 0, 0, 0, false, 0, 0, 0, 0,
                     message_area, discard, discard, discard,
                     discard, discard, discard);

  mouse_button_pressed := (event & e_button) <> 0;

end;


function random(low_value, high_value : integer) : integer;

{
Return a pseudorandom integer between low_value and high_value (inclusive).
Low value must be less than high value.
}


  function random_24_bit : long_integer;

  {
  Return 24 bit pseudorandom integer.
  }

  xbios(17);


begin

  random := int(low_value + (random_24_bit mod (high_value - low_value + 1)));

end;


procedure calc_y(x, z, radius : real; var result : real;
                              var valid_args : boolean);

{
Given the x and z coordinate and the radius of a circle, this procedure
returns the value of y.  If there is no value of y for the given arguements,
valid arguements is false.
}

var
  y_squared : real;

begin

  y_squared := sqr(radius) - sqr(x) - sqr(z);

  valid_args := true;

  if y_squared >= 0.0
    then result := sqrt(y_squared)
    else valid_args := false;

end;


procedure y_rotation(var x, z : real; angle : real);

{
Rotate a point about the y axis.
}

var
  temp_x,
  sin_angle,
  cos_angle : real;

begin

  { Compute these values only once. }
  sin_angle := sin(angle);
  cos_angle := cos(angle);

  temp_x := x *   cos_angle  + z * sin_angle;
  z      := x * (-sin_angle) + z * cos_angle;

  x := temp_x;

end;


procedure draw_sphere(plotting_window : integer; radius, x_center, y_center,
                                 rotation_angle : real; var quit : boolean);

{
Draw a wire-frame sphere rotated about the y axis.  The center
of the sphere prior to rotation is (x_center, y_center).
}

const
  z_delta = 4.0;

var
  x,
  z,
  plot_x,
  plot_y,
  plot_z     : real;
  valid_args : boolean;

begin

  z := -radius;

  quit := false;

  while (z <= radius) and not quit do begin

    x := -radius;

    while x <= radius do begin

      plot_x := x;
      plot_z := z;

      calc_y(plot_x, plot_z, radius, plot_y, valid_args);

      if valid_args
        then begin

          y_rotation(plot_x, plot_z, rotation_angle);

          { Hide lines if drawing the front of a sphere. }
          if plot_z >= 0.0
            then draw_line(round(plot_x + x_center), round( plot_y + y_center),
                           round(plot_x + x_center), round(-plot_y + y_center),
                                                                        erase);

          point(round(plot_x + x_center), round( plot_y + y_center));
          point(round(plot_x + x_center), round(-plot_y + y_center));

        end;

      x := x + 1.0;

    end;

    quit := mouse_button_pressed;
    z := z + z_delta;

  end;

end;


procedure introduce_program;

{
Introduce the program with a dialog box.
}

const
  { Width (in characters) of dialog box }
  box_width = 64;
  color     = $1180;

  { Strings that will be inserted into dialog box. }
  str_1     = 'Spheres 1.0 - A Graphics Demo Program';
  str_2     = 'Written by Eric Bergman-Terrell';
  str_3     = 'of Cadenza Software, Ltd.';
  str_4     = '1704 Imperial Ridge, Las Cruces, NM  88001, USA';
  str_5     = 'Portions of this product are copyright (c) 1986, OSS and CCD';
  str_6     = 'Used by Permission of OSS';
  str_7     = 'This software has been placed in the public domain.';
  str_8     = 'Hold down left mouse button to quit.';
  start_str = 'BEGIN';

var
  intro_box     : dialog_ptr;
  line_1,
  line_2,
  line_3,
  line_4,
  line_5,
  line_6,
  line_7,
  line_8,
  start_button,
  button_pushed : integer;
  start_item    : tree_index;

begin

  { Set up the mouse the be an arrow. }
  init_mouse;
  set_mouse(m_arrow);

  { Get a dialog box. }
  intro_box := new_dialog(8, 0, 0, box_width, 18);

  { Insert strings into dialog box. }
  line_1 := add_ditem(intro_box, g_text, none, 1, 1, box_width, 1, 0, color);
  line_2 := add_ditem(intro_box, g_text, none, 1, 3, box_width, 1, 0, color);
  line_3 := add_ditem(intro_box, g_text, none, 1, 4, box_width, 1, 0, color);
  line_4 := add_ditem(intro_box, g_text, none, 1, 5, box_width, 1, 0, color);
  line_5 := add_ditem(intro_box, g_text, none, 1, 7, box_width, 1, 0, color);
  line_6 := add_ditem(intro_box, g_text, none, 1, 8, box_width, 1, 0, color);
  line_7 := add_ditem(intro_box, g_text, none, 1, 11, box_width, 1, 0, color);
  line_8 := add_ditem(intro_box, g_text, none, 1, 13, box_width, 1, 0, color);
  start_button := add_ditem(intro_box, g_button,
                            exit_btn | selectable | default,
                            30, 16, length(start_str), 1, 0, color);

  { Adjust the strings in the dialog box. }
  set_dtext(intro_box, line_1, str_1, system_font, te_center);
  set_dtext(intro_box, line_2, str_2, system_font, te_center);
  set_dtext(intro_box, line_3, str_3, system_font, te_center);
  set_dtext(intro_box, line_4, str_4, system_font, te_center);
  set_dtext(intro_box, line_5, str_5, system_font, te_center);
  set_dtext(intro_box, line_6, str_6, system_font, te_center);
  set_dtext(intro_box, line_7, str_7, system_font, te_center);
  set_dtext(intro_box, line_8, str_8, system_font, te_center);
  set_dtext(intro_box, start_button, start_str, system_font, te_center);

  center_dialog(intro_box);

  { Introduce the program. }
  button_pushed := do_dialog(intro_box, start_item);

  end_dialog(intro_box);
  delete_dialog(intro_box);

end;


begin

  if init_gem >= 0
    then begin

      introduce_program;

      { Prepare to plot. }
      start_graphics(plotting_window);

      repeat

        draw_sphere(plotting_window, random(20, (maxx + 1) div 6),
                                 random(0, maxx), random(0, maxy),
                                pi * (random(0, 25) / 100), quit);

      until quit;

      stop_graphics(plotting_window);

      exit_gem;

    end;

end.